home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 20 / Cream of the Crop 20 (Terry Blount) (1996).iso / program / n_b_v203.zip / CGB_ALL.DMO < prev    next >
Text File  |  1996-07-04  |  10KB  |  178 lines
  1. $if 0
  2.     ┌──────────────────────────╖                        PowerBASIC v3.20
  3.  ┌──┤          DASoft          ╟──────────────────────┬──────────────────╖
  4.  │  ├──────────────────────────╢    Copyright 1995    │ DATE: 1995-10-01 ╟─╖
  5.  │  │ FILE NAME   CGB_ALL .DMO ║          by          ╘════════════════─ ║ ║
  6.  │  │                          ║  Don Schullian, Jr.                     ║ ║
  7.  │  ╘══════════════════════════╝                                         ║ ║
  8.  │ A license is hereby granted to the holder to use this source code in  ║ ║
  9.  │ any program, commercial or otherwise,  without receiving the express  ║ ║
  10.  │ permission of the copyright holder and without paying any royalties,  ║ ║
  11.  │ as long as this code is not distributed in any compilable format.     ║ ║
  12.  │  IE: source code files, PowerBASIC Unit files, and printed listings   ║ ║
  13.  ╘═╤═════════════════════════════════════════════════════════════════════╝ ║
  14.    │                ....................................                   ║
  15.    ╘═══════════════════════════════════════════════════════════════════════╝
  16. $endif
  17.  
  18. '.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°
  19. ' ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° °
  20.                                            '┌────────────────────────────────
  21. $INCLUDE "DAS-NB01.INC"                    '│
  22. $INCLUDE "DAS-NB02.INC"                    '│
  23. $INCLUDE "DAS-NBV1.INC"                    '│
  24. $INCLUDE "DAS-NBV2.INC"                    '│
  25.                                            '│
  26. %ALT_X = &h2D00                            '│ CVI( CHR$(0,45) )
  27.                                            '│
  28. CLS                                        '│
  29. IF fMouseSETUP?(0) = 0 THEN                '│ gotta have a mouse
  30.   PRINT "CAN'T RUN THIS WITHOUT A MOUSE"   '│
  31.   END                                      '│
  32. END IF                                     '│
  33. IF fDESQview% > 0 THEN                     '│ DESQview & DAC routines
  34.   PRINT "CAN'T RUN THIS WITH DESQ-VIEW"    '│ collide some times
  35.   END                                      '│
  36. END IF                                     '│
  37.                                            '│
  38. SCREEN 12                                  '│ all systems <<GO>>
  39. GraphicSETUP                               '│ set-up for DASoft's graphics
  40. EventSETUP 1, 20                           '│ set-up events
  41. Blank$ = STRING$( 192, 63 )                '│ a flock of 63's for the DAC
  42. DACwriteSTR Blank$                         '│ eveything's white while we draw
  43.                                            '│
  44. Mask$ = fMonoMask$( 94 )                   '│ load a monochrome mask
  45. Mask$ = fColorMask$( Mask$, 3, 8 )         '│ make it a 2color mask
  46. PAINT (0,0), Mask$                         '│ paint the whole screen
  47. GBoxFFRAME 200, 5, 414, 42, 4, 9, 14, 0, 0 '│ title box
  48. LOCATE 2, 28                               '│
  49. PRINT "Graphic Screen Clearing"            '│
  50. GBoxCOLOR2 200, 5, 414, 42, 0, 4           '│ re-color the background
  51.                                            '│
  52. RESTORE DEMODATA                           '│ better safe than sorry
  53. DIM E%(3,17)                               '│ our event array
  54. A? = 0                                     '│
  55. FOR E% = 1 TO 17                           '│ read data & create the screen
  56.   READ M$, Trow?, Tcol?                    '│ msg and text addresses
  57.   FOR X% = 0 TO 3                          '│ event box addresses
  58.     READ E%(X%,E%)                         '│
  59.   NEXT                                     '│
  60.   IF E% = 17 THEN A? = 1                   '│ box 17 is red
  61.   GBoxBEVELA E%(0,E%), 5, A?, A?+5, A?+10  '│ draw the box
  62.   LOCATE Trow?, Tcol? : PRINT M$           '│ print the message
  63. NEXT                                       '│
  64. GBoxCOLOR2 E%(0,17),E%(1,17), _            '│ re-color the background again
  65.            E%(2,17),E%(3,17), 0, 1         '│
  66.                                            '│
  67. DIM P0%(19201), P1%(19201)                 '│ arrays to save the screen
  68. DIM P2%(19201), P3%(19201)                 '│ plane by plane
  69. DIM P???(3)                                '│ pointers to the arrays so
  70. P???(0) = VARPTR32( P0%(0) )               '│ we can put them into a loop
  71. P???(1) = VARPTR32( P1%(0) )               '│
  72. P???(2) = VARPTR32( P2%(0) )               '│
  73. P???(3) = VARPTR32( P3%(0) )               '│
  74. GOSUB SaveScreen                           '│ read screen data
  75. E%(2,0) = 639 : E%(3,0) = 479              '│ whole screen is the event
  76. fEventOpenG E%(0,0), 17                    '│ open the event
  77. fLoadDAScolor                              '│ re-color screen
  78. MouseMakePtr "INVARROW"                    '│ new pointer for the rat
  79.                                            '│
  80. DO                                         '│ menu loop
  81.   MouseONnow                               '│
  82.   G% = fEventKey%( Hit%, CHR$(0,45) )      '│ await action!
  83.   MouseOFF                                 '│ mouse off for now!
  84.   IF ( G%   = %ALT_X ) OR _                '│ <ALT><X>
  85.      ( Hit% = 17     ) THEN EXIT LOOP      '│ <RED BUTTON>
  86.   SELECT CASE Hit%                         '│
  87.     CASE < 0                               '│ no action on MOUSE DOWN
  88.       ITERATE                              '│
  89.     CASE 01                                '│
  90.       ClearGBoxDN    0,0,639,479,0,Noise%  '│
  91.     CASE 02                                '│
  92.       ClearGBoxLF    0,0,639,479,0,Noise%  '│
  93.     CASE 03                                '│
  94.       ClearGBoxZIO   0,0,639,479,0,Noise%  '│
  95.     CASE 04                                '│
  96.       ClearGBoxDIO   0,0,639,479,0,Noise%  '│
  97.     CASE 05                                '│
  98.       ClearGBoxVBH   0,0,639,479,0,Noise%  '│
  99.     CASE 06                                '│
  100.       ClearGBoxDDN   0,0,639,479,0,Noise%  '│
  101.     CASE 07                                '│
  102.       ClearGBoxCLOCK 0,0,639,479,0,Noise%  '│
  103.     CASE 08                                '│
  104.       ClearGBoxUP    0,0,639,479,0,Noise%  '│
  105.     CASE 09                                '│
  106.       ClearGBoxRT    0,0,639,479,0,Noise%  '│
  107.     CASE 10                                '│
  108.       ClearGBoxZOI   0,0,639,479,0,Noise%  '│
  109.     CASE 11                                '│
  110.       ClearGBoxDOI   0,0,639,479,0,Noise%  '│
  111.     CASE 12                                '│
  112.       ClearGBoxVBV   0,0,639,479,0,Noise%  '│
  113.     CASE 13                                '│
  114.       ClearGBoxDUP   0,0,639,479,0,Noise%  '│
  115.     CASE 14                                '│
  116.       ClearGBoxSWEEP 0,0,639,479,0,Noise%  '│
  117.     CASE 15                                '│
  118.       ClearGBoxRND   0,0,639,479,0,Noise%  '│
  119.     CASE 16                                '│
  120.       Noise% = ( Noise% = 0 )              '│ change sound setting
  121.       LOCATE 18, 45                        '│
  122.       IF Noise% THEN ? "N " ELSE ? "FF"    '│ change message
  123.       GOSUB SaveScreen                     '│
  124.       ITERATE                              '│ no screen blanking
  125.   END SELECT                               '│
  126.   DELAY 1                                  '│ pause for effect
  127.   DACwriteSTR Blank$                       '│ everything white again
  128.   FOR P? = 0 TO 3                          '│ put the screen back
  129.     PutParr 0, 0, BYVAL P???(P?), 3, P?    '│
  130.   NEXT                                     '│
  131.   fLoadDAScolor                            '│ recolor the screen
  132. LOOP                                       '│
  133.                                            '│
  134. CLS : PALETTE : SCREEN 0                   '└─────────────────────────────────
  135. END
  136.  
  137. ' ═══════════════════════════════════════════════════════════════════════════
  138. ' ══════════ local stuff from here down ═════════════════════════════════════
  139. ' ═══════════════════════════════════════════════════════════════════════════
  140.                                                '┌────────────────────────────
  141. FUNCTION fGetKey% () LOCAL PUBLIC              '│ This is what fGetKey%
  142.   LOCAL G%                                     '│ looks like when using
  143.                                                '│ fEventKey% the only
  144.   DO